home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 726-750 / 732 / riff / readiff.mod < prev    next >
Text File  |  1995-03-18  |  8KB  |  308 lines
  1. (*#-- BEGIN AutoRevision header, please do NOT edit!
  2. *
  3. *   Program         :   readiff.mod
  4. *   Copyright       :   1992 ©, By DigiSoft
  5. *   Author          :   Marcel Timmermans
  6. *   Address         :   Holthuizerdreef 13, 6852 JH, HUISSEN, HOLLAND
  7. *   Creation Date   :   13-09-1992
  8. *   Current version :   1.0
  9. *   Translator      :   M2Amiga V4.0d
  10. *
  11. *   REVISION HISTORY
  12. *
  13. *   Date          Version         Comment
  14. *   ---------     -------         ------------------------------------------
  15. *
  16. *-- END AutoRevision header --*)
  17.  
  18. IMPLEMENTATION MODULE readiff;
  19.  
  20. (* options list *)
  21. (*$ LargeVars:=FALSE
  22.     StackChk:=FALSE
  23.     OverflowChk:=FALSE
  24.     RangeChk:=FALSE
  25.     ReturnChk:=FALSE
  26.     NilChk:=FALSE
  27.     LongAlign:=FALSE
  28.     Volatile:=FALSE
  29.     StackParms:=FALSE
  30.  *)
  31.  
  32. (*
  33.   This is a simple iff reader written in modula-2. The program is public domain
  34.   so you can modify it or use it or wathever you want to do with it.
  35.   If you use it in your program, please let me now.
  36.  
  37.   The routines 'MakeGraph' and 'DPaintGraph' are written in modula-2 and not
  38.   in assembler !, Why ?
  39.   Just so show easy how to unpack data to your screen.
  40.   If you want to speedup the unpacking just convert it to assembler.
  41.  
  42.   The assemble source that the compiler m2c is making is very fast.
  43.   But offcourse it can quicker !!
  44.  
  45.   If your are making changes, for a better support, error checking
  46.   or its faster. Please send me a copy !
  47.  
  48.   Good luck !
  49.    Marcel Timmermans, 1992 (c) DigiSoft
  50. *)
  51.  
  52. FROM SYSTEM IMPORT ADR,ADDRESS,SHIFT;
  53.  
  54. (* import list *)
  55. IMPORT id:IntuitionD,
  56.        il:IntuitionL,
  57.        gd:GraphicsD,
  58.        gl:GraphicsL,
  59.        dl:DosL,
  60.        dd:DosD,
  61.        s:String,
  62.        R,
  63.        A:Arts,
  64.        H:Heap;
  65.  
  66. (*-- TYPES --*)
  67.  
  68. TYPE
  69.     UByte = [0..255];    (* byte set          *)
  70.     Byte  = [-128..127]; (* unsigned byte set *)
  71.  
  72.     pub= POINTER TO Byte;
  73.  
  74.     (* Bitmap header information *)
  75.     bmhdtype =  RECORD
  76.                   width,height,xpos,ypos : INTEGER;
  77.                   depth, mask, comp : UByte;
  78.                   transCol: INTEGER;
  79.                   xAspect,yAspect: UByte;
  80.                   scrnWidth,scrnHeight: INTEGER;
  81.                 END;
  82.  
  83. (*-- VARS --*)
  84.  
  85. VAR
  86.     HEADER: RECORD
  87.       name  :ARRAY[0..3] OF CHAR;
  88.       length:LONGINT;
  89.       name1 :ARRAY[0..3] OF CHAR;
  90.     END;
  91.  
  92.   ColorTable : ARRAY[0..255] OF CARDINAL;
  93.  
  94.   newScreen: id.NewScreen; (* My screen structure *)
  95.   myscreen : id.ScreenPtr; (* My screen pointer   *)
  96.  
  97.   file: dd.FileHandlePtr;      (* File handler            *)
  98.   r,g,b: CARDINAL;
  99.   colorCnt:INTEGER;            (* Number of Colors used   *)
  100.   bpr:Byte;                    (* BytesPerRow             *)
  101.  
  102.   BODY:pub;                    (* BODY => Pointer to Byte *)
  103.   CMAP:POINTER TO UByte;       (* ColorMAP Pointer        *)
  104.   BMHD:POINTER TO bmhdtype;    (* Bitmap Header Pointer   *)
  105.  
  106.  
  107.  
  108. (*-------------------------------------------------------------------------*)
  109. (*-------------------------------------------------------------------------*)
  110.  
  111. PROCEDURE CleanUp;
  112. BEGIN
  113.  IF file#NIL THEN dl.Close(file ) END;
  114. END CleanUp;
  115.  
  116.  
  117. (* normal mode *)
  118. PROCEDURE MakeGraph(body:pub;planes:ARRAY OF ADDRESS);
  119. VAR i{R.D2},j{R.D3},k{R.D4},offset{R.D5}: LONGINT;
  120.     dest{R.A3}:pub;
  121. BEGIN
  122.   i:=0;offset:=0;
  123.   REPEAT
  124.     j:=0;
  125.     REPEAT
  126.       dest:=pub(planes[j]+offset);
  127.       k:=0;
  128.       REPEAT
  129.        dest^:=body^;
  130.        INC(dest);INC(body);INC(k);
  131.       UNTIL k=bpr;
  132.       INC(j);
  133.     UNTIL j=LONGINT(myscreen^.bitMap.depth);
  134.     INC(i);INC(offset,bpr);
  135.   UNTIL i=LONGINT(myscreen^.bitMap.rows);
  136. END MakeGraph;
  137.  
  138. (* compressed mode *)
  139. PROCEDURE DPaintGraph(body{R.A2}:pub;planes:ARRAY OF ADDRESS);
  140. VAR i{R.D2}: LONGINT;
  141.     sofar{R.D4}:Byte;
  142.     byte{R.D5},depth,j{R.D3}:Byte;
  143.     dest{R.A3}:pub;
  144.     offset:INTEGER;
  145.     rows:LONGINT;
  146.  
  147. BEGIN
  148.   i:=0;offset:=0;
  149.   depth:=Byte(myscreen^.bitMap.depth);
  150.   rows:=LONGINT(myscreen^.bitMap.rows);
  151.   REPEAT (* line counter 'i' *)
  152.     j:=0;
  153.     REPEAT (* plane counter 'j' *)
  154.       sofar:=bpr;
  155.       dest:=pub(planes[j]+offset);
  156.       WHILE sofar > 0 DO
  157.        byte:=body^; INC(body);
  158.        IF byte=128 THEN
  159.        ELSIF byte > 0 THEN
  160.         INC(byte);
  161.         DEC(sofar,byte);
  162.         REPEAT
  163.          dest^:=body^;
  164.          INC(dest);INC(body);DEC(byte);
  165.         UNTIL byte<=0;
  166.        ELSE
  167.         byte:=-byte + 1;
  168.         DEC(sofar,byte);
  169.         REPEAT
  170.          dest^:=body^;INC(dest);
  171.          DEC(byte);
  172.         UNTIL byte<=0;
  173.         INC(body);
  174.        END;
  175.       END;
  176.       INC(j);
  177.     UNTIL j=depth;
  178.     INC(i);INC(offset,bpr);
  179.   UNTIL i=rows;
  180. END DPaintGraph;
  181.  
  182.  
  183. PROCEDURE ReadILBM(name:ARRAY OF CHAR;VAR YourScreen:id.ScreenPtr):IFFErrors;
  184. VAR chunk:ADDRESS;
  185.     t:INTEGER;
  186. BEGIN
  187.   (* Be sure that pointers are nil *)
  188.   BODY:=NIL;
  189.   CMAP:=NIL;
  190.   BMHD:=NIL;
  191.  
  192.   (* open the iff file *)
  193.   file := dl.Open(ADR(name),dd.oldFile);
  194.   IF file=NIL THEN RETURN iffOpenfailed; END;
  195.  
  196.   (* read the header file "FORM",size,"ILBM" *)
  197.   IF (dl.Read(file, ADR(HEADER), SIZE(HEADER)) # SIZE(HEADER)) THEN
  198.    RETURN iffHeaderfailed;
  199.   END;
  200.  
  201.   (* Check for the ILBM Header file *)
  202.   IF (s.Compare(HEADER.name,"FORM")#0) OR (s.Compare(HEADER.name1,"ILBM")#0) THEN
  203.    RETURN iffWrongIFF;
  204.   END;
  205.  
  206.   (* Get the needed chunks and allocate the needed memory for them *)
  207.   WHILE (dl.Read( file, ADR(HEADER), 8) = 8) DO
  208.  
  209.    IF (s.Compare(HEADER.name,'BMHD')=0) OR
  210.       (s.Compare(HEADER.name,'CMAP')=0) OR
  211.       (s.Compare(HEADER.name,'BODY')=0)
  212.    THEN
  213.   (* Easy to use Heap.Allocate , but you make your own list or use Remember *)
  214.     H.Allocate(chunk,HEADER.length);
  215.     IF chunk=NIL THEN RETURN iffOutOfMem; END;
  216.  
  217.     IF (dl.Read(file, chunk, HEADER.length) # HEADER.length) THEN
  218.      RETURN iffHeaderfailed;
  219.     END;
  220.  
  221.     IF (s.Compare(HEADER.name,'BMHD')=0) THEN
  222.           BMHD:=chunk;
  223.     ELSIF (s.Compare(HEADER.name,'CMAP')=0) THEN
  224.           CMAP:=chunk;
  225.     ELSIF (s.Compare(HEADER.name,'BODY')=0) THEN
  226.           BODY:=chunk;
  227.     END;
  228.    ELSE
  229.     (* Don't get unneeded headers *)
  230.     IF dl.Seek( file, HEADER.length, 0) > 0 THEN END;
  231.    END;
  232.   END;
  233.  
  234.  (* close the opened file *)
  235.  IF file#NIL THEN dl.Close(file); file:=NIL END;
  236.  
  237.  (* you can leave this away but this is a second check if i get everything *)
  238.  IF (BMHD=NIL) OR (BODY=NIL) THEN
  239.   A.Assert(TRUE,ADR("No body, bmhd allocate"));
  240.  END;
  241.  
  242.   (* setup my screen *)
  243.   WITH newScreen DO
  244.       width:=BMHD^.width;
  245.       height:=BMHD^.height;
  246.       depth:=BMHD^.depth;
  247.       leftEdge := 0;
  248.       topEdge := 0;
  249.       viewModes := gd.ViewModeSet{};
  250.       IF (width>320) THEN INCL(viewModes,gd.hires) END;
  251.       IF height>256  THEN INCL(viewModes,gd.lace) END;
  252.       IF depth>5     THEN INCL(viewModes,gd.ham) END;
  253.       detailPen := 0; blockPen := 0;
  254.       type := id.customScreen+id.ScreenFlagSet{id.screenQuiet,id.screenBehind};
  255.       font := NIL;
  256.       defaultTitle := NIL;
  257.       gadgets := NIL;
  258.       customBitMap := NIL;
  259.     END;
  260.  
  261.     (* open the screen behind every otherscreen *)
  262.     YourScreen := il.OpenScreen(newScreen);
  263.     IF YourScreen=NIL THEN RETURN iffOpenScreenfailed; END;
  264.     myscreen:=YourScreen;
  265.  
  266.     (* set the right colors which we use *)
  267.     colorCnt:= SHIFT(1,BMHD^.depth);
  268.     IF CMAP#NIL THEN
  269.       FOR t:=0 TO colorCnt-1 DO
  270.        r:=CARDINAL(CMAP^); INC(CMAP);
  271.        g:=CARDINAL(CMAP^); INC(CMAP);
  272.        b:=CARDINAL(CMAP^); INC(CMAP);          (* >> *)
  273.        ColorTable[t] := (SHIFT(r,4) + g + SHIFT(b,-4));
  274.       END;
  275.       gl.LoadRGB4(ADR(YourScreen^.viewPort),ADR(ColorTable), colorCnt);
  276.     END;
  277.  
  278.     (* How many bytes per row ? *)
  279.     bpr:=Byte(YourScreen^.bitMap.bytesPerRow);
  280.  
  281.     (* copy picture data to screen bitmap
  282.        First checkout if compressed or Not
  283.      *)
  284.     IF (BMHD^.comp=0) THEN
  285.       MakeGraph(BODY,YourScreen^.bitMap.planes);
  286.     ELSIF (BMHD^.comp=1) THEN (* compressed *)
  287.       DPaintGraph(BODY,YourScreen^.bitMap.planes);
  288.     END;
  289.  
  290.     (* screen to front mode , to see the picture *)
  291.     il.ScreenToFront(YourScreen);
  292.  
  293.     (* just free the needed memory *)
  294.     IF CMAP#NIL THEN H.Deallocate(CMAP); END;
  295.     IF BODY#NIL THEN H.Deallocate(BODY); END;
  296.     IF BMHD#NIL THEN H.Deallocate(BMHD); END;
  297.     RETURN iffNoErr;
  298. END ReadILBM;
  299.  
  300. (*-------------------------------------------------------------------------*)
  301. (*-------------------------------------------------------------------------*)
  302.  
  303. BEGIN
  304.  file := NIL;
  305. CLOSE
  306.  CleanUp;
  307. END readiff.
  308.